COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 -*- Syntax: Common-lisp Package: PZ Default-character-style: (:FIX :BOLD :NORMAL) -*-
C00007 00003	 SHOWBOARD is the main display function.  It prints out almost all of the board state of
C00012 ENDMK
C⊗;
;;; -*- Syntax: Common-lisp; Package: PZ; Default-character-style: (:FIX :BOLD :NORMAL) -*-

;;; There are several boards included here which are useful for testing and debugging.

(defparameter *easy-puzzle*
	      (let ((*default-initial-position*
		       '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 :blank 15)))
		(make-board :blank 15 :name "Easy-Board")))

(defparameter *easy-puzzle2*
	      (let ((*default-initial-position*
		       '(1 2 3 4 5 6 7 8 9 10 :blank 12 13 14 11 15)))
		(make-board :blank 11 :name "Easy Puzzle 2"))) 

;;; *STUCK* is an unsolvable board.  (It is not reachable from the solved postion.)

(defparameter *stuck*  (let ((*default-initial-position*
			       '(1 2 3 4 5 6 7 8 9 10 11 12 13 15 14 :BLANK)))
			 (make-board :blank 16 :name "Stuck Board")))

(defparameter *blocked-4* (let ((*default-initial-position*
				  '(1 2 3 6 7 9 11 4 5 12 8 :BLANK 14 15 10 13)))
			    (make-board :blank 12 :name "Blocked 4")))

(defparameter *blocked-at-13* (let ((*default-initial-position*
				      '(1 2 3 4 5 6 7 8 9 10 11 15 :BLANK 12 14 13)))
				(make-board :blank 13 :name "Blocked 4")) )

(defparameter *solved-board* (make-board :name "Solved Board"))
(evaluate-initial-position *solved-board*)

(defparameter *random-board* (make-board :name "Random Board"))

;;; CHECK-GOODNESS is just an error checking routine to make sure that we don't attempt to
;;; solve a malformed board.  One test that it is missing is the parity test to make sure
;;; that the board it is given is actually solvable - I wasn't sure how it went.  The
;;; RANDOM-BOARD function only generates solvable boards, though.

(defun check-goodness (board)
  (unless (or (unless (numberp (board-size board))
		(Format t "Non numeric board size: ~s in ~a"
			(board-size board) (board-name board)) t)
	      (when (or (not (numberp (board-blank board)))
			(> (board-blank board) (expt (board-size board) 2))
			(> 1 (board-blank board)))
		(format t "~&The Blank is said to be in position ~s in ~s~&"
			(board-blank board) (board-name board)) t)
	      (unless (eq (position-contents (board-blank board) board) :blank)
		(format t "~&The :BLANK is not in square ~d in ~a.~&"
			(board-blank board) (board-name board)) t)
	      (unless (every #'(lambda (tile)
				 (find tile (board-position board) :key #'identity))
			     *default-initial-position*)
		(format t "~&In ~a, some tile was not found in the board position ~a, with contents~&~a~&"
			(board-name board) (board-position board)
			(coerce (board-position board) 'list)) t))
    t))

;;; SHOWBOARD is the main display function.  It prints out almost all of the board state of
;;; any interest.  It doesn't print out the movelist, because it's too lengthly.  The
;;; (VALUES) call at the end just keeps the thing from printing an extra NIL when called at
;;; the Command: level.

(defun showboard (board)
  (check-goodness board)
  (format t "~&     ~'b⊂~a~⊃~&~{  ~s~10t~s~20t~s~30t~s~&~}~&  ~
	~'i⊂Blank: ~s~15tCompleted Chain: ~s~39tLast-complete-row: ~s~
	~65tBlank-Origin: ~s    Moves: ~s~⊃~&"
	  (board-name board)
	  (Coerce (board-position board) 'list)
	  (board-blank board)(board-completed-chain board)
	  (board-last-complete-row board)(board-blank-origin board)
	  (length (board-moves board)))
  (format t "~&     ~'i⊂Acceptances: ~s   Rejections: ~s   Nodes Considered: ~s    ~
       Ply Depth: ~s    Queue Length: ~s~⊃~&"
	  *acceptances* *rejections* *nodes-considered* (ply-depth board)
	  (length (fifo-queue-line *queue*)))
  (showstats)
  (values))

;;; SHOWSTATS shows the statistics on how many times each of the heuristics has succeeded.

(defun showstats ()
  (format t "~& Better Heuristics: ~{~25t~:(~a:~)  ~a~↑~55t~:(~a:  ~a~&~)~}~&"
	  (loop for heu in *better-measures*
		collect heu
		collect (get heu :success)))
  (format t "~& Worse Heuristics:  ~{~25t~:(~a:~)  ~a~↑~55t~:(~a:  ~a~&~)~}~&"
	  (loop for heu in *worse-measures*
		collect heu
		collect (get heu :success)))
  (values))

;;; Generate a random board position which is still solvable.  Do this by moving the blank
;;; at random 300 times.  Each time through the loop, get the legal moves from the
;;; Stored-Succesors function and choose one at random.

(defun random-board (&key (board *random-board*)(pathlen 300))
  (copy-board-position board *solved-board*)
  (initialize-problem board)
  (loop for count from 1 to pathlen
	for moves = (stored-successors (list (board-blank board)) board)
	do (move (nth (random (length moves)) moves) board))
  board)

;;; PLY-DEPTH is only used by the SHOWBOARD function to show the intermediate state of the
;;; calculation.  It shows how many more moves the next node on the queue has than the
;;; *base-board* has.

(defun ply-depth (&optional (bb *base-board*))
  (- (length (first (fifo-queue-line *queue*)))
     (length (board-moves bb))))


;;; CLEAR-HEURISTIC-STATISTICS is invoked at initialization of the problem to set the
;;; accumulated successes of all the heuristics back to zero.  These statistics are
;;; accumulated on each heuristic's property list.  They are incremented by MAY-ACCEPT and
;;; MAY-REJECT.

(defun clear-heuristic-statistics ()
  (mapc #'(lambda (heu)
	    (setf (get heu :success) 0))
	*worse-measures*)
  (mapc #'(lambda (heu)
	    (setf (get heu :success) 0))
	*better-measures*))